home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 221 / pascal / fplot2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-17  |  3.3 KB  |  162 lines
  1. PROGRAM fplot;
  2.  
  3.   CONST
  4.     pi = 3.14159;
  5.     {$I gemconst.pas}
  6.  
  7.   TYPE
  8.     {$I gemtype.pas}
  9.  
  10.   VAR
  11.     phi,theta : real;
  12.     x,y,z : real;
  13.     scalex,scaley,scalez : real;
  14.     event,
  15.     which,
  16.     dummy,
  17.     handle,
  18.     wind_type : integer ;
  19.     title : Window_Title ;
  20.     c0,r0 : integer;
  21.     msg : message_buffer;
  22.  
  23.   {$I gemsubs.pas}
  24.  
  25. procedure f ( var x,y,z : real);    {calculate x,y,z from r,phi,theta}
  26.  
  27. var
  28.   r : real;
  29.  
  30. begin
  31.   r := (sin(phi)-1)/2;        {this is the  function}
  32.   x := r*sin(phi)*cos(theta);
  33.   y := r*sin(phi)*sin(theta);
  34.   z := r*cos(phi);
  35. end;
  36.  
  37. procedure draw_f;         {draw the function line on the screen}
  38.  
  39. var
  40.   f : string[255];
  41.  
  42. begin
  43.   line_color(2);
  44.   f := 'r := (sin(phi)-1)/2;';
  45.   draw_string(c0-3*length(f),195,f);
  46.   draw_string(20,20,'Programmed by G. F. Sellars');
  47.   draw_string(20,30,'      with Oss Pascal');
  48. end;
  49.  
  50. procedure project(z,x,y : real; var c,r : integer);
  51.  
  52. var                     {project 3d to 2d, swap axes}
  53.   d : real;
  54.  
  55. begin
  56.   d := scalez*z;
  57.   c := round(scalex*(x+d))+c0;    { c := raster column}
  58.   r := round(scaley*(y+d))+r0;    { r := raster row}
  59. end;
  60.  
  61. PROCEDURE plot_curve;
  62.  
  63. var
  64.   c,r : integer;
  65.  
  66. begin
  67.   phi := 0;                   {plot latitude lines}
  68.   while phi <= 2*pi do begin  {0 to 2pi will get all possible trig values}
  69.     theta := 0;
  70.     f(x,y,z);
  71.     project(x,y,z,c,r);
  72.     move_to(c,r);
  73.     while theta <= 2*pi do begin
  74.       f(x,y,z);
  75.       project(x,y,z,c,r);
  76.       line_to(c,r);
  77.       theta := theta+pi/18;
  78.     end;
  79.     phi := phi+pi/18;
  80.   end;
  81.   theta := 0;
  82.   while theta <= 2*pi do begin          {plot longitude lines}
  83.     phi := 0;
  84.     f(x,y,z);
  85.     project(x,y,z,c,r);
  86.     move_to(c,r);
  87.     while phi <= 2*pi do begin
  88.       f(x,y,z);
  89.       project(x,y,z,c,r);
  90.       line_to(c,r);
  91.       phi := phi+pi/18;
  92.     end;
  93.     theta := theta+pi/18;
  94.   end;
  95. END;
  96.  
  97. procedure axis(x0,y0,z0,x1,y1,z1 :real; name : char);
  98.  
  99. var                             {plot x,y,or z axis}
  100.   c,r : integer;
  101.  
  102. begin
  103.   project(x0,y0,z0,c,r);
  104.   move_to(c,r);
  105.   project(x1,y1,z1,c,r);
  106.   line_to(c,r);
  107.   project(1.1*x1,1.1*y1,1.1*z1,c,r);
  108.   draw_string(c,r,name);
  109. end;
  110.  
  111. procedure init;
  112.  
  113. var
  114.   i,c,r,w,h: integer;
  115.   wr,hr : real;
  116.  
  117. begin
  118.   handle := New_Window(0,title,0,0,0,0);
  119.   Open_Window(handle,0,0,0,0);
  120.   Work_Rect(handle,c,r,w,h);
  121.   Set_Clip(c,r,w,h);
  122.   Paint_Style(Solid);
  123.   Paint_Color(White);
  124.   Paint_Rect(c,r,w,h);
  125.   c0 := (w-c) div 2;              {c0,r0 = center of screen}
  126.   r0 := (h-r) div 2;
  127.   r0 := r0+16;
  128.   wr := w-c; hr := h-r;
  129.   scalex := wr/4;
  130.   scaley := -hr/2.5;
  131.   scalez := -1/4;
  132.   Line_Color(2);
  133.   text_color(2);
  134.   axis(-3,0,0,3,0,0,'x');
  135.   axis(0,-1,0,0,1,0,'y');
  136.   axis(0,0,-1,0,0,1,'z');
  137.   Line_Color(1);
  138. end;
  139.  
  140. BEGIN
  141.   IF Init_Gem >= 0 THEN BEGIN
  142.     Hide_Mouse ;
  143.     Begin_Update ;
  144.     init;
  145.     plot_curve;
  146.     draw_f;
  147.     End_Update ;
  148.     write(chr(7));     {ring bell when done}
  149.     repeat
  150.       event := get_event(e_button | e_timer,1,1,1,
  151.                        10,
  152.                        false,0,0,0,0,
  153.                        false,0,0,0,0,
  154.                        msg,dummy,dummy,dummy,dummy,dummy,dummy);
  155.     until event & e_button <> 0;   {left mouse button clicked once}
  156.     Show_Mouse ;
  157.     Close_Window( handle ) ;
  158.     Delete_Window( handle ) ;
  159.   END;
  160.   Exit_Gem ;
  161. END.
  162.